library(dplyr)
library(ggplot2)
library(tidytext)
library(rtweet)
library(plotly)
library(circlize) # https://jokergoo.github.io/circlize_book/book/
load("data/transcripts.RData")
load("data/ratings.RData")
Inicialmente, minha ideia era utilizar dados do twitter (texto e hora do tweet) de alguma partida de futebol e comparar a frequência de determinadas palavras com os eventos do jogo.
No entanto, um problema que surgiu foi que a api gratuita do Twitter aparentemente não retorna tweets de maneira constante ao decorrer da partida. Segue um exemplo em que temos tweets apenas para alguns intervalos de tempo do jogo.
tweets = parse_stream("CEAxFLU.json")
ts_plot(tweets, by = "mins") + # função do rtweet que utiliza o ggplot
theme_bw()
Este problema me fez desistir da proposta inicial e buscar outras opções para o trabalho final.
Alguns meses atrás, navegando no Reddit, encontrei uma visualização que me chamou bastante atenção:
na época, eu estava estudando mineração de textos e tive a ideia de utilizar métodos de text mining para buscar palavras que identifiquem cada personagem e avaliar a relação entre a quantidade de falas de um personagem em um episódio com a nota do episódio no IMDB. Como eu nunca assisti The Office, a série desta visualização, decidi utilizar os dados da série Avatar: The Last Airbender (ATLA). Grande parte do trabalho de obtenção e limpeza dos dados assim como a parte de mineração de textos já estava pronta, porém eu não havia feito praticamente nenhuma visualização para este projeto. Desse modo, optei por continuar este projeto fazendo as visualizações neste trabalho final.
Os datasets que serão utilizados são:
O script dos 61 episódios do ATLA disponível em: http://avatar.wikia.com/wiki/Avatar_Wiki:Transcripts;
As notas do IMDB desta série que pode ser encontrada em: https://www.imdb.com/title/tt0417299/.
Ambos os conjuntos de dados foram coletados via web scraping. O código do scrape está no arquivo scrape.R.
Data frame do roteiro
transcripts
Data frame das ratings
ratings
Inicialmente, realizei um pre-processamento nos textos, removi as introduções e tudo que estava entre colchetes.
Exemplo de texto antes da limpeza
transcripts$text[2]
[1] "It's not getting away from me this time. [Close-up of the boy as he grins confidently over his shoulder in the direction of the girl.] Watch and learn, Katara. This is how you catch a fish.\n"
intro = transcripts$text[1]
transcripts = transcripts %>%
filter(text != intro) %>% # tirando as introducoes
mutate(text = stringr::str_replace_all(text, '\\[(.*?)\\]', ''), # tirando o que ta entre colchetes
text = qdapRegex::rm_number(text))
Exemplo de texto depois da limpeza
transcripts$text[1] # índice 1 pois removi a introdução
[1] "It's not getting away from me this time. Watch and learn, Katara. This is how you catch a fish."
Agora, colocarei o texto no formato de um data frame de uma palavra por linha, com todas as palavras em caixa baixa e removerei as seguintes stop words:
sort(unique(stop_words$word))
[1] "a" "a's" "able" "about" "above"
[6] "according" "accordingly" "across" "actually" "after"
[11] "afterwards" "again" "against" "ain't" "all"
[16] "allow" "allows" "almost" "alone" "along"
[21] "already" "also" "although" "always" "am"
[26] "among" "amongst" "an" "and" "another"
[31] "any" "anybody" "anyhow" "anyone" "anything"
[36] "anyway" "anyways" "anywhere" "apart" "appear"
[41] "appreciate" "appropriate" "are" "area" "areas"
[46] "aren't" "around" "as" "aside" "ask"
[51] "asked" "asking" "asks" "associated" "at"
[56] "available" "away" "awfully" "b" "back"
[61] "backed" "backing" "backs" "be" "became"
[66] "because" "become" "becomes" "becoming" "been"
[71] "before" "beforehand" "began" "behind" "being"
[76] "beings" "believe" "below" "beside" "besides"
[81] "best" "better" "between" "beyond" "big"
[86] "both" "brief" "but" "by" "c"
[91] "c'mon" "c's" "came" "can" "can't"
[96] "cannot" "cant" "case" "cases" "cause"
[101] "causes" "certain" "certainly" "changes" "clear"
[106] "clearly" "co" "com" "come" "comes"
[111] "concerning" "consequently" "consider" "considering" "contain"
[116] "containing" "contains" "corresponding" "could" "couldn't"
[121] "course" "currently" "d" "definitely" "described"
[126] "despite" "did" "didn't" "differ" "different"
[131] "differently" "do" "does" "doesn't" "doing"
[136] "don't" "done" "down" "downed" "downing"
[141] "downs" "downwards" "during" "e" "each"
[146] "early" "edu" "eg" "eight" "either"
[151] "else" "elsewhere" "end" "ended" "ending"
[156] "ends" "enough" "entirely" "especially" "et"
[161] "etc" "even" "evenly" "ever" "every"
[166] "everybody" "everyone" "everything" "everywhere" "ex"
[171] "exactly" "example" "except" "f" "face"
[176] "faces" "fact" "facts" "far" "felt"
[181] "few" "fifth" "find" "finds" "first"
[186] "five" "followed" "following" "follows" "for"
[191] "former" "formerly" "forth" "four" "from"
[196] "full" "fully" "further" "furthered" "furthering"
[201] "furthermore" "furthers" "g" "gave" "general"
[206] "generally" "get" "gets" "getting" "give"
[211] "given" "gives" "go" "goes" "going"
[216] "gone" "good" "goods" "got" "gotten"
[221] "great" "greater" "greatest" "greetings" "group"
[226] "grouped" "grouping" "groups" "h" "had"
[231] "hadn't" "happens" "hardly" "has" "hasn't"
[236] "have" "haven't" "having" "he" "he'd"
[241] "he'll" "he's" "hello" "help" "hence"
[246] "her" "here" "here's" "hereafter" "hereby"
[251] "herein" "hereupon" "hers" "herself" "hi"
[256] "high" "higher" "highest" "him" "himself"
[261] "his" "hither" "hopefully" "how" "how's"
[266] "howbeit" "however" "i" "i'd" "i'll"
[271] "i'm" "i've" "ie" "if" "ignored"
[276] "immediate" "important" "in" "inasmuch" "inc"
[281] "indeed" "indicate" "indicated" "indicates" "inner"
[286] "insofar" "instead" "interest" "interested" "interesting"
[291] "interests" "into" "inward" "is" "isn't"
[296] "it" "it'd" "it'll" "it's" "its"
[301] "itself" "j" "just" "k" "keep"
[306] "keeps" "kept" "kind" "knew" "know"
[311] "known" "knows" "l" "large" "largely"
[316] "last" "lately" "later" "latest" "latter"
[321] "latterly" "least" "less" "lest" "let"
[326] "let's" "lets" "like" "liked" "likely"
[331] "little" "long" "longer" "longest" "look"
[336] "looking" "looks" "ltd" "m" "made"
[341] "mainly" "make" "making" "man" "many"
[346] "may" "maybe" "me" "mean" "meanwhile"
[351] "member" "members" "men" "merely" "might"
[356] "more" "moreover" "most" "mostly" "mr"
[361] "mrs" "much" "must" "mustn't" "my"
[366] "myself" "n" "name" "namely" "nd"
[371] "near" "nearly" "necessary" "need" "needed"
[376] "needing" "needs" "neither" "never" "nevertheless"
[381] "new" "newer" "newest" "next" "nine"
[386] "no" "nobody" "non" "none" "noone"
[391] "nor" "normally" "not" "nothing" "novel"
[396] "now" "nowhere" "number" "numbers" "o"
[401] "obviously" "of" "off" "often" "oh"
[406] "ok" "okay" "old" "older" "oldest"
[411] "on" "once" "one" "ones" "only"
[416] "onto" "open" "opened" "opening" "opens"
[421] "or" "order" "ordered" "ordering" "orders"
[426] "other" "others" "otherwise" "ought" "our"
[431] "ours" "ourselves" "out" "outside" "over"
[436] "overall" "own" "p" "part" "parted"
[441] "particular" "particularly" "parting" "parts" "per"
[446] "perhaps" "place" "placed" "places" "please"
[451] "plus" "point" "pointed" "pointing" "points"
[456] "possible" "present" "presented" "presenting" "presents"
[461] "presumably" "probably" "problem" "problems" "provides"
[466] "put" "puts" "q" "que" "quite"
[471] "qv" "r" "rather" "rd" "re"
[476] "really" "reasonably" "regarding" "regardless" "regards"
[481] "relatively" "respectively" "right" "room" "rooms"
[486] "s" "said" "same" "saw" "say"
[491] "saying" "says" "second" "secondly" "seconds"
[496] "see" "seeing" "seem" "seemed" "seeming"
[501] "seems" "seen" "sees" "self" "selves"
[506] "sensible" "sent" "serious" "seriously" "seven"
[511] "several" "shall" "shan't" "she" "she'd"
[516] "she'll" "she's" "should" "shouldn't" "show"
[521] "showed" "showing" "shows" "side" "sides"
[526] "since" "six" "small" "smaller" "smallest"
[531] "so" "some" "somebody" "somehow" "someone"
[536] "something" "sometime" "sometimes" "somewhat" "somewhere"
[541] "soon" "sorry" "specified" "specify" "specifying"
[546] "state" "states" "still" "sub" "such"
[551] "sup" "sure" "t" "t's" "take"
[556] "taken" "tell" "tends" "th" "than"
[561] "thank" "thanks" "thanx" "that" "that's"
[566] "thats" "the" "their" "theirs" "them"
[571] "themselves" "then" "thence" "there" "there's"
[576] "thereafter" "thereby" "therefore" "therein" "theres"
[581] "thereupon" "these" "they" "they'd" "they'll"
[586] "they're" "they've" "thing" "things" "think"
[591] "thinks" "third" "this" "thorough" "thoroughly"
[596] "those" "though" "thought" "thoughts" "three"
[601] "through" "throughout" "thru" "thus" "to"
[606] "today" "together" "too" "took" "toward"
[611] "towards" "tried" "tries" "truly" "try"
[616] "trying" "turn" "turned" "turning" "turns"
[621] "twice" "two" "u" "un" "under"
[626] "unfortunately" "unless" "unlikely" "until" "unto"
[631] "up" "upon" "us" "use" "used"
[636] "useful" "uses" "using" "usually" "uucp"
[641] "v" "value" "various" "very" "via"
[646] "viz" "vs" "w" "want" "wanted"
[651] "wanting" "wants" "was" "wasn't" "way"
[656] "ways" "we" "we'd" "we'll" "we're"
[661] "we've" "welcome" "well" "wells" "went"
[666] "were" "weren't" "what" "what's" "whatever"
[671] "when" "when's" "whence" "whenever" "where"
[676] "where's" "whereafter" "whereas" "whereby" "wherein"
[681] "whereupon" "wherever" "whether" "which" "while"
[686] "whither" "who" "who's" "whoever" "whole"
[691] "whom" "whose" "why" "why's" "will"
[696] "willing" "wish" "with" "within" "without"
[701] "won't" "wonder" "work" "worked" "working"
[706] "works" "would" "wouldn't" "x" "y"
[711] "year" "years" "yes" "yet" "you"
[716] "you'd" "you'll" "you're" "you've" "young"
[721] "younger" "youngest" "your" "yours" "yourself"
[726] "yourselves" "z" "zero"
ut = transcripts %>%
unnest_tokens(word, text) %>%
anti_join(stop_words, by = "word") # retirando stop words
ut
Contagem de palavras por personagem (após remoção de stop words):
count_speaker = ut %>%
count(speaker) %>%
arrange(desc(n))
count_speaker
Como nesta série, cada personagem tem uma origin ligada a um dos quatro elementos (água, fogo, terra e ar), optei por inserir esta informação nas visualizações.
As cores selecionadas foram escolhidas a partir da vestimenta dos personagens e da seguinte imagem:
water = "#27A3EB"
fire = "#D7333C"
earth = "#6FCC36"
air = "gold1"
personagens = count_speaker$speaker[1:18]
origin = tibble(speaker = personagens, origin = c("water", "air", "water", "fire", "fire", "earth", "fire", "fire", "earth", "water", "air", "fire", "fire", "earth", "water", "earth", "earth", "fire"))
origin
count_speaker$Selecionado = "Não"
count_speaker$Selecionado[1:18] = "Sim"
n_outros = sum(count_speaker$n[which(count_speaker$Selecionado == "Não")])
count_speaker %>%
head(24) %>%
rbind(tibble(speaker = "Outros", n = n_outros, Selecionado = "Não")) %>%
mutate(speaker = factor(speaker, levels = speaker)) %>%
ggplot(aes(x = speaker, y = n, alpha = Selecionado, fill = speaker)) +
geom_bar(stat = "identity") +
xlab("Personagem") +
ylab("Quantidade de palavras") +
theme_bw() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.3)) +
scale_alpha_discrete(range = c(0.3, 0.9)) +
ggtitle("Palavras por personagens e personagens selecionados") +
guides(alpha = guide_legend(reverse = TRUE), fill = FALSE) +
scale_fill_manual(values = c(water, air, water, fire, fire, earth,
fire, fire, earth, water, air, fire,
fire, earth, water, earth, earth, fire,
earth, water, fire, fire, fire, water, "black"))
Optei por utilizar apenas os 18 personagens com maior número de palavras e calcular as palavras mais utilizadas e a medida tf-idf considerando cada personagem como um documento. A medida tf-idf nos permite avaliar palavras que caracterizam um determinado documento, neste caso personagem, em relação a um conjunto de documentos. Ela é calculada da seguinte forma:
\[ w_{t,d} = \frac{tf_{t,d}}{\sum_{t' \in d}f_{t',d}} \times log \Bigg( \frac{N}{n_t} \Bigg) \]
em que
\(w_{t,d}\) é o valor do o peso para o termo \(t\) no documento \(d\);
\(tf_{t,d}\) é a quantidade de vezes que o termo \(t\) aparece no documento \(d\);
\(\sum_{t' \in d}f_{t',d}\) é a quantidade total de termos do documento \(d\);
\(N\) é o número total de documentos;
\(n_t\) é o número de documentos que contém o termo \(t\).
tfidf = ut %>%
filter(speaker %in% personagens) %>%
count(word, speaker) %>%
bind_tf_idf(word, speaker, n) %>%
arrange(desc(tf_idf))
Visualizando as palavras mais utilizadas e os maiores tf-idf por personagem
tmp1 = tibble(speaker = count_speaker$speaker[1:18],
order_speaker = 1:18)
tmp2 = tfidf %>%
inner_join(tmp1, by = "speaker") %>%
mutate(speaker = reorder(speaker, order_speaker)) %>%
arrange(speaker, desc(n)) %>%
group_by(speaker) %>%
do(head(., 10)) %>%
ungroup() %>%
arrange(speaker, n) %>%
mutate(order_word = row_number())
tmp3 = tfidf %>%
inner_join(tmp1, by = "speaker") %>%
mutate(speaker = reorder(speaker, order_speaker)) %>%
arrange(speaker, desc(tf_idf)) %>%
group_by(speaker) %>%
do(head(., 10)) %>%
ungroup() %>%
arrange(speaker, tf_idf) %>%
mutate(order_word = row_number())
tmp2 %>%
ggplot(aes(x = order_word, y = n, fill = speaker)) +
geom_bar(stat = "identity", show.legend = FALSE) +
facet_wrap(~ speaker, scales = "free", ncol = 6) +
theme_bw() +
scale_x_continuous(breaks = tmp2$order_word, labels = tmp2$word) +
scale_y_continuous(breaks = scales::pretty_breaks(2)) +
coord_flip() +
labs(title = "Palavras mais utilizadas por personagens",
x = NULL,
y = "n") +
scale_fill_manual(values = c(water, air, water, fire, fire, earth,
fire, fire, earth, water, air, fire,
fire, earth, water, earth, earth, fire))
tmp3 %>%
ggplot(aes(x = order_word, y = tf_idf, fill = speaker)) +
geom_bar(stat = "identity", show.legend = FALSE) +
facet_wrap(~ speaker, scales = "free", ncol = 6) +
xlab("words") +
ylab("tf-idf") +
theme_bw() +
scale_x_continuous(breaks = tmp3$order_word, labels = tmp3$word) +
scale_y_continuous(breaks = scales::pretty_breaks(2)) +
coord_flip() +
labs(title = "Palavras com maiores tf-idf por personagem",
x = NULL,
y = "tf-idf") +
scale_fill_manual(values = c(water, air, water, fire, fire, earth,
fire, fire, earth, water, air, fire,
fire, earth, water, earth, earth, fire))
Finalmente, fiz uma visualização da matriz de frequência dos termos destes personagens utilizando análise de agrupamentos hierárquica para fazer a ordenação das linhas e colunas desta matriz.
mat = reshape2::acast(tfidf, word ~ speaker, value.var = "tf", fill = 0)
rownames(mat) = rep("", nrow(mat))
heatmap(mat)
O que chama a atenção nesta matriz é que existem diversos termos que são utilizados apenas por um único personagem.
Exemplo de termos que apenas o personagem “Sokka” disse:
sokka = ut %>%
filter(speaker == "Sokka") %>%
count(word)
not_sokka = ut %>%
filter(speaker != "Sokka") %>%
select(word) %>%
distinct(.keep_all = TRUE)
sokka %>%
anti_join(not_sokka, by = "word") %>%
arrange(desc(n))
Primeiramente, agrupei as informações das notas com a base do roteiro e criei uma variável para indicar a quantidade de palavras dos personagens por episódio.
tmp = tibble(epi_num = unique(transcripts$epi_num), rating = ratings$rating)
words_epi = ut %>%
inner_join(tmp, by = "epi_num") %>%
filter(speaker %in% personagens) %>%
count(epi_num, rating, speaker)
words_epi
Por exemplo o personagem Aang disse 125 palavras (com remoção de stop words) no episódio 1.
Agora, visualizamos a base com as notas dos episódios e a quantidade de falas dos personagens por episódio.
ratings$Temporada = as.factor(c(rep("Book One: Air", 20), rep("Book two: Earth", 20), rep("Book Three: Fire", 21)))
p = ratings %>%
mutate(text = paste0("Episódio: ", epi_num, "<br>",
"Título ", epi_name, "<br>",
"Nota: ", rating, "<br>")) %>%
ggplot(aes(x = epi_num, y = rating, fill = Temporada, text = text)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c(water, earth, fire)) +
theme_bw() +
coord_cartesian(ylim = c(0, 10)) +
ggtitle("Nota do IMDB por episódio") +
xlab("Episódio") +
ylab("Nota") +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0))
p %>% ggplotly(tooltip = c("text"))
tmp4 = reshape2::acast(words_epi, epi_num ~ speaker, value.var = "n", fill = 0) %>%
reshape2::melt()
names(tmp4) = c("epi_num", "speaker", "n")
tmp4 = tmp4 %>%
inner_join(tmp1, by = "speaker") %>%
mutate(speaker = reorder(speaker, order_speaker))
tmp4 %>%
ggplot(aes(x = epi_num, y = n, fill = speaker)) +
geom_bar(stat = "identity", show.legend = FALSE) +
facet_wrap(~ speaker, scales = "free", ncol = 3) +
ylim(0, 300) +
theme_bw() +
scale_fill_manual(values = c(water, air, water, fire, fire, earth,
fire, fire, earth, water, air, fire,
fire, earth, water, earth, earth, fire)) +
ggtitle("Quantidade de palavras por episódio") +
xlab("Episódio") +
ylab("Quantidade de palavras") +
scale_x_continuous(expand = c(0, 0))
Posteriormente, calculei a correlação de Spearman entre a proporção de falas do personagem e a nota do IMDB. Preferi utilizar esta medida de correlação ao invés da correlação de Pearson pois não espero que a correlação entre estas variáveis seja linear visto que existem muitos personagens que não possuem falas em diversos episódios.
f <- function(personagem) {
out = NULL
for(i in 1:61) {
tmp = words_epi %>%
filter(speaker == personagem,
epi_num == i) %>%
.$n
out[i] = ifelse(length(tmp) == 0, 0, tmp)
}
out
}
mat2 = ratings$rating %>%
cbind(sapply(personagens, f))
colnames(mat2)[1] = "rating"
mat_rating = cor(mat2, method = "spearman")
cor_rating = mat_rating[-1, 1]
sort(cor_rating, decreasing = TRUE)
Ozai Toph Azula Zuko Hakoda Suki Iroh
0.40201919 0.33825857 0.30884073 0.29001220 0.23496605 0.20880807 0.18218638
Roku Zhao Bumi Long Feng Hama Mai Pathik
0.17188827 0.16380385 0.15973407 0.14013893 0.12121646 0.11751625 0.05556310
Jet Sokka Aang Katara
-0.06679389 -0.43891654 -0.46230858 -0.55510008
tibble(spearman = cor_rating, speaker = names(cor_rating)) %>%
inner_join(origin, by = "speaker") %>%
mutate(speaker = reorder(speaker, spearman)) %>%
ggplot(aes(speaker, spearman, fill = origin)) +
geom_bar(stat = "identity") +
xlab("Personagem") +
ylab("Correlação de Spearman") +
ggtitle("Correlações de Spearman \nentre a quantidade de palavras do personagem por episódio e notas do IMDB") +
theme_bw() +
scale_y_continuous(breaks = scales::pretty_breaks(3)) +
scale_fill_manual(values = c("water" = water, "fire" = fire, "air" = air, "earth" = earth)) +
guides(fill = FALSE) +
theme(axis.text.x = element_text(angle = 90, vjust = 0.3))
Utilizando a matriz de correlação criada na seção anterior, realizei uma análise de agrupamentos hierárquica para buscar personagens que tendem a ter quantidades de falas similares nos mesmos episódios.
clusters = hclust(as.dist(1-mat_rating[-1,-1]))
ggdendro::ggdendrogram(clusters)
Podemos ver que as maiores similaridades estão entre Azula/Mai e Sokka/Katara. O que faz sentido visto que estes pares tendem a aparecer juntos nos episódios.
Posteriormente, considerei apenas as palavras referentes aos nomes dos 18 personagens selecionados e ilustrei a quantidade de vezes que um personagem diz o nome de outro. Note que a diferença das alturas indicam a direção das falas.
tmp6 = tfidf %>%
filter(word %in% stringr::str_to_lower(c(personagens, "feng"))) %>%
mutate(speaker = stringr::str_to_lower(speaker))
tmp6$speaker[which(tmp6$speaker == "long feng")] = "feng"
mat3 = reshape2::acast(tmp6, speaker ~ word, value.var = "n", fill = 0)
colnames(mat3) = c("Aang", "Azula", "Bumi", "Feng", "Hakoda", "Hama", "Iroh",
"Jet", "Katara", "Mai", "Ozai", "Pathik", "Roku", "Sokka",
"Suki", "Toph", "Zhao", "Zuko")
rownames(mat3) = colnames(mat3)
grid.col = c(Aang = air, Azula = fire, Bumi = earth, Feng = earth, Hakoda = water,
Hama = water, Iroh = fire, Jet = earth, Katara = water, Mai = fire,
Ozai = fire, Pathik = air, Roku = fire, Sokka = water, Suki = earth,
Toph = earth, Zhao = fire, Zuko = fire)
circos.clear()
circos.par(start.degree = 90, clock.wise = TRUE)
chordDiagram(mat3, grid.col = grid.col, annotationTrack = c("name", "grid"), directional = 1, diffHeight = uh(7), order = c("Pathik", "Aang", "Katara", "Sokka", "Hakoda", "Hama", "Toph", "Bumi", "Feng", "Jet", "Suki", "Zuko", "Roku", "Ozai", "Iroh", "Azula", "Mai", "Zhao"))